home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / dbview1a / dbviewer.bas next >
Encoding:
BASIC Source File  |  1998-11-29  |  4.9 KB  |  91 lines
  1. Attribute VB_Name = "DBViewer"
  2. 'Color/other variable for Gradient
  3. Global gRed As Long
  4. Global gGreen As Long
  5. Global gBlue As Long
  6. Global gTopToBottom As Boolean
  7. Global gTint As Integer
  8.  
  9. Option Explicit
  10.  
  11. '**************************************************************************************
  12. ' I STOLE THIS CODE OFF THE WEB A WHILE BACK. IT WORKS BETTER THAN THE ONE I DEVELOPED.
  13. ' I MADE SEVERAL IMPROVEMENTS BUT I LEFT ALL THE GLORY FOR JOHN ON THIS ONE.
  14. '**************************************************************************************
  15. '
  16. '**************************************************************************************
  17. ' I Added a 'Tint' argument to John's code to control the amount of black drawn on the
  18. ' object. 1 to 500, The lower the number the lighter the tint. This also depends on the
  19. ' height of the object being painted. (50 to 100 is a good starting place.)
  20. '**************************************************************************************
  21.  
  22. 'Gradient Background Source code - Released into the public domain by John Rogers
  23. 'June 19, 1996
  24. '
  25. 'Requires VB40032.DLL.
  26. 'Gradient Background Demonstration program requires COMCTL32.OCX and THREED32.OCX
  27. '
  28. '   This was written in 800x600 mode, so my apologies to those running in 640x480. >:-P
  29. '
  30. '   Quicky destructions: To gradient a form with, say, the blue-to-black gradient found in
  31. 'most setup programs, you would put the command
  32. '                            Gradient Me, 0, 0, 255, 1
  33. 'into the Resize sub. In the form's properties, turn on AutoRedraw, set the Appearance to Flat
  34. 'and you're done! Compile the program and admire your nice gradient! Warning: Due to Windows'
  35. 'lousy dithering, this will look absolutely TERRIBLE in anything less than 16-bit (high) color.
  36. 'But then again, so do all those setup programs >:-)
  37. 'How it works:
  38. '   Pretty simple, really. It just divides the object into 63 sections and fills each one with
  39. 'a slightly darker color than the previous one, starting with the given RGB value and ending
  40. 'with black. I think that was a run-on, but who cares. It's not like this is documentation.
  41. 'For a semi-nifty effect, try commenting one or two of the decrement lines. You'll wind up with
  42. 'a two-color gradient. You can also make sideways gradients by swapping a few variables. Knock
  43. 'yourself out; this is public domain, which means you can alter it to your heart's content! Have
  44. 'fun! Incidentally, the demo program does have a real use: you can use it to design a nicely
  45. 'colored background, then write down the syntax. Type it into VB as it is shown, and you'll get
  46. 'Your gradient just as it appeared! (If you don't, you most likely ) Like this program?
  47. 'Drop me a line at patr@xanadu2.net. Happy shading!
  48. '
  49. Sub Gradient(TheObject As Object, Redval&, Greenval&, Blueval&, TopToBottom As Boolean, Tint As Integer)
  50.     'TheObject can be any object that supports the Line method (like forms and pictures).
  51.     'Redval, Greenval, and Blueval are the Red, Green, and Blue starting values from 0 to 255.
  52.     'TopToBottom determines whether the gradient will draw down or up.
  53.     Dim Step%, Reps%, FillTop%, FillLeft%, FillRight%, FillBottom%, HColor$
  54.     'This will create 63 steps in the gradient. This looks smooth on 16-bit and 24-bit color.
  55.     'You can change this, but be careful. You can do some strange-looking stuff with it...
  56.     Step = (TheObject.Height / Tint) '63
  57.     'This tells it whether to start on the top or the bottom and adjusts variables accordingly.
  58.     If TopToBottom = True Then FillTop = 0 Else FillTop = TheObject.Height - Step
  59.     FillLeft = 0
  60.     FillRight = TheObject.Width
  61.     FillBottom = FillTop + Step
  62.     'If you changed the number of steps, change the number of reps to match it.
  63.     'If you don't, the gradient will look all funny.
  64.     For Reps = 1 To Tint    '63
  65.         'This draws the colored bar.
  66.         TheObject.Line (FillLeft, FillTop)-(FillRight, FillBottom), RGB(Redval, Greenval, Blueval), BF
  67.         'This decreases the RGB values to darken the color.
  68.         'Lower the value for "squished" gradients. Raise it for incomplete gradients.
  69.         'Also, if you change the number of steps, you will need to change this number.
  70.         Redval = Redval - 4
  71.         Greenval = Greenval - 4
  72.         Blueval = Blueval - 4
  73.         'This prevents the RGB values from becoming negative, which causes a runtime error.
  74.         If Redval <= 0 Then Redval = 0
  75.         If Greenval <= 0 Then Greenval = 0
  76.         If Blueval <= 0 Then Blueval = 0
  77.         'More top or bottom stuff; Moves to next bar.
  78.         If TopToBottom = True Then FillTop = FillBottom Else FillTop = FillTop - Step
  79.         FillBottom = FillTop + Step
  80.     Next
  81.     
  82.   'Because these values have been decrimented by the loop above
  83.   'we must restore its original value.
  84.   gRed = GetSetting(App.Title, "Settings", "gRed", 10)
  85.   gGreen = GetSetting(App.Title, "Settings", "gGreen", 255)
  86.   gBlue = GetSetting(App.Title, "Settings", "gBlue", 255)
  87.  
  88. End Sub
  89.  
  90.  
  91.